unit uDZLinkList;

interface

uses
  Classes, Windows, uDZSysUtils, uDZThread;

type
  TDzLinkList = class;
  TDzDblLinkList = class;

  TDzListMode = (lmStack, lmQueue);

  TDzLinkListNode = class
  private
    fList: TDzLinkList;
    fNext: TDzLinkListNode;
  public
    constructor Create(Owner: TDzLinkList); virtual;
    destructor Destroy; override;
    property Next: TDzLinkListNode read fNext;
  end;

  TDzLinkListNodeClass = class of TDzLinkListNode;

  TDzLinkListNodeProc = function(LinkList: TDzLinkList;
    Node: TDzLinkListNode; Param: Pointer): Boolean;
      
  TDzLinkList = class
  private
    fCriticalSection: TDzCriticalSection;
    fNodeClass: TDzLinkListNodeClass;
    fListHead: TDzLinkListNode;
    fCount: Integer;
  public
    constructor Create(NodeCls: TDzLinkListNodeClass;
      MultiThread: Boolean); virtual;
    destructor Destroy; override;
    procedure Lock;
    procedure Release;
    procedure Push(Node: TDzLinkListNode);
    procedure LockPush(Node: TDzLinkListNode);
    function Pop: TDzLinkListNode;
    function LockPop: TDzLinkListNode;
    function Add: TDzLinkListNode;
    procedure Delete(Node: TDzLinkListNode);
    procedure Clear;
    function Iterate(Proc: TDzLinkListNodeProc; Param: Pointer): Boolean;
    property ListHead: TDzLinkListNode read fListHead;
    property Count: Integer read fCount;
  end;

  TDzDblLinkListNode = class
  private
    fList: TDzDblLinkList;
    fPrevious: TDzDblLinkListNode;
    fNext: TDzDblLinkListNode;
  public
    constructor Create(Owner: TDzDblLinkList); virtual;
    destructor Destroy; override;
    function Compare(other: TDzDblLinkListNode): TCompareResult; virtual;
    property Previous: TDzDblLinkListNode read fPrevious;
    property Next: TDzDblLinkListNode read fNext;
  end;

  TDzDblLinkListNodeClass = class of TDzDblLinkListNode;

  PDzBinarySearchIndex = ^TBinarySearchIndex;
  TBinarySearchIndex = record
    index: Integer;
    LeftIndex: Integer;
    RightIndex: Integer;
    current: TDzDblLinkListNode;
    left: PDzBinarySearchIndex;
    right: PDzBinarySearchIndex;
  end;

  TDzIntNode = class(TDzDblLinkListNode)
  private
    fValue: Integer;
  public
    function Compare(other: TDzDblLinkListNode): TCompareResult; override;
    property Value: Integer read fValue write fValue;
  end;

  TDzDblLinkListNodeProc = function(LinkList: TDzDblLinkList;
    Node: TDzDblLinkListNode; Param: Pointer): Boolean;
    
  TDzDblLinkList = class
  private
    fCriticalSection: TDzCriticalSection;
    fMode: TDzListMode;
    fNodeClass: TDzDblLinkListNodeClass;
    fListHead: TDzDblLinkListNode;
    fListTail: TDzDblLinkListNode;
    fCount: Integer;
    fSorted: Boolean;
    procedure SetSorted(const Value: Boolean);
    procedure _Insert(Node: TDzDblLinkListNode; insertAfter: TDzDblLinkListNode);
    function GetItems(index: Integer): TDzDblLinkListNode;
  protected
    function GetInsertAfter(Node: TDzDblLinkListNode;
      var param: Integer): TDzDblLinkListNode; virtual;
    procedure AfterSort; dynamic;
    procedure AfterInsert(param: Integer); dynamic;
  public
    constructor Create(NodeCls: TDzDblLinkListNodeClass;
      WorkMode: TDzListMode; MultiThread: Boolean); virtual;
    destructor Destroy; override;
    procedure Lock;
    procedure Release;
    procedure Push(Node: TDzDblLinkListNode);
    procedure LockPush(Node: TDzDblLinkListNode);
    function Pop: TDzDblLinkListNode;
    function LockPop: TDzDblLinkListNode;
    function Add: TDzDblLinkListNode;
    procedure Delete(Node: TDzDblLinkListNode);
    procedure Clear;
    procedure Insert(Node: TDzDblLinkListNode; insertAfter: TDzDblLinkListNode);
    procedure Exchange(node1, node2: TDzDblLinkListNode);
    function Iterate(Proc: TDzDblLinkListNodeProc; Param: Pointer): Boolean;
    procedure InsertSort;
    property Mode: TDzListMode read fMode;
    property ListHead: TDzDblLinkListNode read fListHead;
    property ListTail: TDzDblLinkListNode read fListTail;
    property Count: Integer read fCount;
    property Items[index: Integer]: TDzDblLinkListNode read GetItems;
    property Sorted: Boolean read fSorted write SetSorted;
  end;

  TDzNodeIndex = record
    index: Integer;
    Node: TDzDblLinkListNode;
  end;
  PDzNodeIndex = ^TDzNodeIndex;
  
  TDzBinarySearchDblLinkList = class(TDzDblLinkList)
  private
    fNodeIndexes: array [0..99] of TDzNodeIndex;
    fNodeIndexCount: Integer;
    function GetNode(index: Integer): TDzDblLinkListNode;
  protected
    function GetInsertAfter(Node: TDzDblLinkListNode;
      var param: Integer): TDzDblLinkListNode; override;
    procedure AfterSort; override;
    procedure AfterInsert(param: Integer); override;
  public
    destructor Destroy; override;
  end;
  
implementation

uses
  RTLConsts;

{ TDzLinkList }

function TDzLinkList.Add: TDzLinkListNode;
begin
  Result := fNodeClass.Create(Self);
end;

procedure TDzLinkList.Clear;
begin
  while fListHead <> nil do fListHead.Free;
end;

constructor TDzLinkList.Create(NodeCls: TDzLinkListNodeClass;
  MultiThread: Boolean);
begin
  fNodeClass := NodeCls;
  if MultiThread then
    fCriticalSection := TDzCriticalSection.Create(100);
  fListHead := nil;
  fCount := 0;
end;

procedure TDzLinkList.Delete(Node: TDzLinkListNode);
var
  prev, cur: TDzLinkListNode;
begin
  if Node = nil then Exit;
  prev := nil;
  cur := fListHead;
  while (cur <> Node) and (cur <> nil) do
  begin
    prev := cur;
    cur := cur.Next;
  end;

  if cur = Node then
  begin
    if prev = nil then fListHead := Node.Next
    else prev.fNext := Node.fNext;
    Dec(fCount);
  end;
end;

destructor TDzLinkList.Destroy;
begin
  Clear;
  fCriticalSection.Free;
  inherited;
end;

function TDzLinkList.Iterate(Proc: TDzLinkListNodeProc;
  Param: Pointer): Boolean;
var
  Node: TDzLinkListNode;
begin
  Node := fListHead;
  while Node <> nil do
  begin
    Result := Proc(Self, Node, Param);
    if not Result then Exit;
    Node := Node.Next;
  end;
  Result := True;    
end;

procedure TDzLinkList.Lock;
begin
  fCriticalSection.Acquire(INFINITE);
end;

function TDzLinkList.LockPop: TDzLinkListNode;
begin
  Lock;
  try
    Result := Pop;
  finally
    Release;
  end;
end;

procedure TDzLinkList.LockPush(Node: TDzLinkListNode);
begin
  Lock;
  try
    Push(Node);
  finally
    Release;
  end;
end;

function TDzLinkList.Pop: TDzLinkListNode;
begin
  Result := fListHead;
  if Result <> nil then fListHead := Result.Next;
  Dec(fCount);
end;

procedure TDzLinkList.Push(Node: TDzLinkListNode);
begin
  Node.fList := Self;
  Node.fNext := fListHead;
  fListHead := Node;
  Inc(fCount);
end;

procedure TDzLinkList.Release;
begin
  fCriticalSection.Release;
end;

{ TDzLinkListNode }

constructor TDzLinkListNode.Create(Owner: TDzLinkList);
begin
  fList := Owner;
  if Owner <> nil then Owner.Push(Self);
end;

destructor TDzLinkListNode.Destroy;
begin
  if fList <> nil then fList.Delete(Self);
  inherited;
end;

{ TDzDblLinkListNode }

function TDzDblLinkListNode.Compare(other: TDzDblLinkListNode): TCompareResult;
begin
  Result := crEqual;
end;

constructor TDzDblLinkListNode.Create(Owner: TDzDblLinkList);
begin
  fList := Owner;
  if Owner <> nil then Owner.Push(Self);
end;

destructor TDzDblLinkListNode.Destroy;
begin
  if fList <> nil then fList.Delete(Self);
  inherited;
end;

{ TDzDblLinkList }

function TDzDblLinkList.Add: TDzDblLinkListNode;
begin
  Result := fNodeClass.Create(Self);
end;

procedure TDzDblLinkList.AfterInsert(param: Integer);
begin

end;

procedure TDzDblLinkList.AfterSort;
begin

end;

procedure TDzDblLinkList.Clear;
begin
  while fListHead <> nil do fListHead.Free;
end;

constructor TDzDblLinkList.Create(NodeCls: TDzDblLinkListNodeClass;
  WorkMode: TDzListMode; MultiThread: Boolean);
begin
  if MultiThread then
    fCriticalSection := TDzCriticalSection.Create(100);
  fMode := WorkMode;
  fNodeClass := NodeCls;
  fListHead := nil;
  fListTail := nil;
  fCount := 0;
end;

procedure TDzDblLinkList.Delete(Node: TDzDblLinkListNode);
begin
  if Node = nil then Exit;
  if Node = fListHead then fListHead := Node.Next;
  if Node = fListTail then fListTail := Node.Previous;
  if Node.Previous <> nil then Node.Previous.fNext := Node.Next;
  if Node.Next <> nil then Node.Next.fPrevious := Node.Previous;
  Node.fPrevious := nil;
  Node.fNext := nil;
  Node.fList := nil;
  Dec(fCount);
end;

destructor TDzDblLinkList.Destroy;
begin
  Clear;
  fCriticalSection.Free;
  inherited;
end;

procedure TDzDblLinkList.Exchange(node1, node2: TDzDblLinkListNode);
var
  p1: TDzDblLinkListNode;
  p2: TDzDblLinkListNode;
begin
  if node1.Next = node2 then
  begin
    Delete(node1);
    Insert(node1, node2);
  end
  else if node1.Previous = node2 then
  begin
    Delete(node2);
    Insert(node2, node1);
  end
  else begin
    p1 := node1.Previous;
    p2 := node2.Previous;
    Delete(node1);
    Delete(node2);
    Insert(node1, p2);
    Insert(node2, p1);
  end;
end;

function TDzDblLinkList.GetInsertAfter(Node: TDzDblLinkListNode;
  var param: Integer): TDzDblLinkListNode;
begin
  Result := fListHead;
  while (Result <> nil) and (Result.Compare(Node) <> crGreater) do
    Result := Result.Next;
  if Result = nil then Result := fListTail
  else Result := Result.Previous;
end;

function TDzDblLinkList.GetItems(index: Integer): TDzDblLinkListNode;
var
  cnt: Integer;
begin
  if index >= Count then TList.Error(@SListindexError, index);
  Result := fListHead;
  cnt := 0;
  while cnt < index do Result := Result.Next;
end;

procedure TDzDblLinkList._Insert(Node, insertAfter: TDzDblLinkListNode);
var
  n: TDzDblLinkListNode;
begin
  Node.fList := Self;
  Node.fPrevious := insertAfter;
  if insertAfter = nil then
  begin
    Node.fNext := fListHead;
    if fListHead = nil then fListTail := Node
    else fListHead.fPrevious := Node;
    fListHead := Node;
  end
  else begin
    n := insertAfter.Next;
    insertAfter.fNext := Node;
    Node.fNext := n;
    if n = nil then fListTail := Node
    else n.fPrevious := Node;
  end;
  Inc(fCount);
end;

procedure TDzDblLinkList.Insert(Node, insertAfter: TDzDblLinkListNode);
begin
  if fSorted then Push(Node)
  else _Insert(Node, insertAfter);
end;

procedure TDzDblLinkList.InsertSort;
var
  cur, prev, next: TDzDblLinkListNode;
begin
  cur := fListHead;
  while cur <> nil do
  begin
    prev := cur.Previous;
    next := cur.Next;
    while (prev <> nil) and (prev.Compare(
      cur) = crGreater) do prev := prev.Previous;
    if prev <> cur.Previous then
    begin
      Delete(cur);
      _Insert(cur, prev);
    end;
    cur := next;
  end;
  AfterSort;
end;

function TDzDblLinkList.Iterate(Proc: TDzDblLinkListNodeProc;
  Param: Pointer): Boolean;
var
  Node: TDzDblLinkListNode;
begin
  Node := fListHead;
  while Node <> nil do
  begin
    Result := Proc(Self, Node, Param);
    if not Result then Exit;
    Node := Node.Next;
  end;
  Result := True;    
end;

procedure TDzDblLinkList.Lock;
begin
  fCriticalSection.Acquire;
end;

function TDzDblLinkList.LockPop: TDzDblLinkListNode;
begin
  Lock;
  try
    Result := Pop;
  finally
    Release;
  end;
end;

procedure TDzDblLinkList.LockPush(Node: TDzDblLinkListNode);
begin
  Lock;
  try
    Push(Node);
  finally
    Release;
  end;
end;

function TDzDblLinkList.Pop: TDzDblLinkListNode;
begin
  if Count = 0 then Result := nil
  else begin
    if fMode = lmStack then Result := fListHead
    else Result := fListTail;
    Delete(Result);
  end;
end;

procedure TDzDblLinkList.Push(Node: TDzDblLinkListNode);
var
  param: Integer;
  after: TDzDblLinkListNode;
begin
  if fSorted then
  begin
    if fCount = 0 then
    begin
      _Insert(Node, nil);
      AfterInsert(-1);
    end
    else begin
      after := GetInsertAfter(Node, param);
      _Insert(Node, after);
      AfterInsert(param);
    end;
  end
  else _Insert(Node, nil);
end;

procedure TDzDblLinkList.Release;
begin
  fCriticalSection.Release;
end;

procedure TDzDblLinkList.SetSorted(const Value: Boolean);
begin
  if fSorted <> Value then
  begin
    if Value then InsertSort;
    fSorted := Value;
  end;
end;

{ TDzBinarySearchDblLinkList }

procedure TDzBinarySearchDblLinkList.AfterInsert(param: Integer);
begin

end;

procedure TDzBinarySearchDblLinkList.AfterSort;
var
  i, n, cnt, index: Integer;
  Node: TDzDblLinkListNode;
  sep: Integer;
begin
  sep := Self.Count div Length(fNodeIndexes);
  if sep < Length(fNodeIndexes) then sep := Length(fNodeIndexes);
  Node := ListHead;
  cnt := Self.Count;
  index := 0;
  fNodeIndexCount := 0;
  while (cnt > 0) and (fNodeIndexCount < Length(fNodeIndexes)) do
  begin
    if sep > cnt then n := cnt
    else n := sep;
    for i := 0 to  n - 2 do Node := ListHead.Next;
    Inc(index, sep);
    fNodeIndexes[fNodeIndexCount].index := index - 1;
    fNodeIndexes[fNodeIndexCount].Node := Node;
    Inc(fNodeIndexCount);
    Node := Node.Next;
    Dec(cnt, n);
  end;
end;

destructor TDzBinarySearchDblLinkList.Destroy;
begin
    
  inherited;
end;

{$WARNINGS OFF}

function TDzBinarySearchDblLinkList.GetInsertAfter(Node: TDzDblLinkListNode;
  var param: Integer): TDzDblLinkListNode;
var
  L, R, M: Integer;
begin
  L := 0;
  R := Self.Count - 1;
  while L <= R do
  begin
    M := (L + R) div 2;
    Result := GetNode(M);
    case Result.Compare(Node) of
      crLess:
        begin
          if Result.Next = nil then
          begin
            param := M;
            Exit;
          end;
          if Result.Next.Compare(Node) in [crEqual, crGreater] then
          begin
            param := M;
            Exit;
          end;
          L := M + 1;
        end;
      crEqual:
        begin
          param := M;
          Exit;
        end;
      crGreater:
        begin
          if Result.Previous = nil then
          begin
            Result := nil;
            param := -1;
            Exit;
          end;
          if Result.Previous.Compare(Node) in [crEqual, crLess] then
          begin
            Result := Result.Previous;
            param := M - 1;
            Exit;
          end;
          R := M - 1;
        end;
    end;
  end;
end;

function TDzBinarySearchDblLinkList.GetNode(index: Integer): TDzDblLinkListNode;
var
  i: Integer;
  distance, cur, abscur: Integer;
  Node: TDzDblLinkListNode;
  function AbsInt(src: Integer): Integer;
  begin
    if src >= 0 then Result := src
    else Result := -src;
  end;
begin
  distance := $7fffffff;
  if fNodeIndexCount = 0 then Result := GetItems(index)
  else begin
    for i := 0 to fNodeIndexCount - 1 do
    begin
      cur := index - fNodeIndexes[i].index;
      abscur := AbsInt(cur);
      if abscur < AbsInt(distance) then
      begin
        distance := cur;
        Node := fNodeIndexes[i].Node;
      end;
      if abscur < 10 then Break;
    end;
    Result := Node;
    if distance >= 0 then
    begin
      for i := 0 to abscur - 1 do Result := Result.Next;
    end
    else begin 
      for i := 0 to abscur - 1 do Result := Result.Previous;
    end;
  end;
end;

{$WARNINGS ON}

{ TDzIntNode }

function TDzIntNode.Compare(other: TDzDblLinkListNode): TCompareResult;
begin
  Result := IntToCompareResult(fValue - TDzIntNode(other).Value);
end;

end.
